PC Plus SuperCD (UK) 1995 March/PC Plus Super CD (Issue 101) (March 1995).iso/sharewar/vbaddon/vbfiles/sam4fnam.frm

Visual Basic Form | 1994-06-17 | 7.2 KB | 214 lines

VERSION 2.00
Begin Form frmRenameFields
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VB/ISAM Sample Program SAM4 -- Rename Fields"
   ClientHeight    =   1425
   ClientLeft      =   1410
   ClientTop       =   3495
   ClientWidth     =   6675
   ControlBox      =   0   'False
   Height          =   2115
   Left            =   1350
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1425
   ScaleWidth      =   6675
   Top             =   2865
   Width           =   6795
   Begin SSPanel plnWholeForm
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BevelInner      =   1  'Inset
      Font3D          =   0  'None
      ForeColor       =   &H00FF0000&
      Height          =   1395
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   6675
      Begin SSPanel pnlSpinner
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         Font3D          =   0  'None
         ForeColor       =   &H00FF0000&
         Height          =   615
         Left            =   1650
         TabIndex        =   2
         Top             =   330
         Width           =   495
         Begin SpinButton spnSpinButton
            BackColor       =   &H00C0C0C0&
            Delay           =   75
            ForeColor       =   &H00000000&
            Height          =   435
            Left            =   90
            ShadowBackColor =   &H00808080&
            ShadowForeColor =   &H00FFFFFF&
            SpinForeColor   =   &H000000FF&
            TdThickness     =   2
            Top             =   90
            Width           =   315
         End
      End
      Begin SSPanel pnlDoneButton
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         Font3D          =   0  'None
         ForeColor       =   &H00FF0000&
         Height          =   975
         Left            =   5070
         TabIndex        =   5
         Top             =   210
         Width           =   1365
         Begin SSCommand cmdDone
            Caption         =   "Done"
            Font3D          =   0  'None
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "MS Sans Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   795
            Left            =   90
            Outline         =   0   'False
            Picture         =   SAM4FNAM.FRX:0000
            TabIndex        =   1
            Top             =   90
            Width           =   1185
         End
      End
      Begin TextBox txtFieldName
         Height          =   315
         Left            =   2340
         TabIndex        =   0
         Text            =   "Text1"
         Top             =   480
         Width           =   2535
      End
      Begin Label Label3
         BackStyle       =   0  'Transparent
         Caption         =   "Field Name"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   225
         Left            =   2340
         TabIndex        =   8
         Top             =   210
         Width           =   1245
      End
      Begin Label Label2
         BackStyle       =   0  'Transparent
         Caption         =   "Up/Dn"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   225
         Left            =   1650
         TabIndex        =   7
         Top             =   990
         Width           =   585
      End
      Begin Label Label1
         BackStyle       =   0  'Transparent
         Caption         =   "Field No. / Type"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   225
         Left            =   270
         TabIndex        =   6
         Top             =   210
         Width           =   1245
      End
      Begin Label lblFieldNum
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "123 [X$*123]"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   510
         Width           =   1245
      End
   End
   Begin Menu mnuMouseless
      Caption         =   "Mouseless operation"
      Begin Menu mnuSpinHigher
         Caption         =   "Spin to &higher field"
      End
      Begin Menu mnuSpinLower
         Caption         =   "Spin to &lower field"
      End
   End
Option Explicit
Dim ValueChangedFlag As Integer
Sub cmdDone_Click ()
    If ValueChangedFlag = True Then UpdateSchema
    Me.Hide
End Sub
Sub DisplayNewField ()
        SchemaLine = DS_GetField(Schema, CRLFDelim, FieldNum + 1)
        ThisType = DS_GetField(SchemaLine, BarDelim, 2)
        If ThisType = "&" Then  'Windows gets weird with ampersands!
            lblFieldNum.Caption = Format$(FieldNum, "000") & " [" & "&&" & "]"
        Else
            lblFieldNum.Caption = Format$(FieldNum, "000") & " [" & ThisType & "]"
        End If
        txtFieldName.Text = DS_GetField(SchemaLine, BarDelim, 3)
        lblFieldNum.Refresh
        txtFieldName.Refresh
End Sub
Sub Form_Activate ()
    ValueChangedFlag = False    'init.
End Sub
Sub mnuSpinHigher_Click ()
    spnSpinButton_SpinDown
End Sub
Sub mnuSpinLower_Click ()
    spnSpinButton_SpinUp
End Sub
Sub spnSpinButton_SpinDown ()
    If ValueChangedFlag = True Then UpdateSchema
    If FieldNum < NumberOfFields Then
        FieldNum = FieldNum + 1
        DisplayNewField
    End If
End Sub
Sub spnSpinButton_SpinUp ()
    If ValueChangedFlag = True Then UpdateSchema
    If FieldNum > 0 Then
        FieldNum = FieldNum - 1
        DisplayNewField
    End If
End Sub
Sub txtFieldName_Change ()
    ValueChangedFlag = True
End Sub
Sub txtFieldName_LostFocus ()
    UpdateSchema
End Sub
Sub UpdateSchema ()
    'Reset local flag
    ValueChangedFlag = False
    If txtFieldName.Text <> "" Then
        'Use new value of txtFieldName.Caption to update schema:
        SchemaLine = DS_PutField(SchemaLine, BarDelim, 3, US_Trim((txtFieldName.Text)))
        Schema = DS_PutField(Schema, CRLFDelim, FieldNum + 1, SchemaLine)
        'Set flag to require update of display and rewrite of schema file:
        SchemaDirtyFlag = True
    End If
End Sub